Introducción

Este modelo abarca el período de tiempo desde 2019 hasta julio de 2024.

Se bajan los datos

ruta_productos <- "/cloud/project/df_dif.xlsx"
excel_sheets(ruta_productos)
## [1] "Sheet 1"
productos <- as.data.frame(read_xlsx(ruta_productos, sheet = "Sheet 1", col_names = T))
productos <- select(.data = productos, c("Fecha", "dif"))
colnames(productos) <- c("Fecha", "Totales")
head(productos)
##        Fecha    Totales
## 1 2019-07-03 -2.8586186
## 2 2019-07-04  0.6996184
## 3 2019-07-05  0.8669633
## 4 2019-07-06  0.1055037
## 5 2019-07-08  0.5360249
## 6 2019-07-09 -1.4721819
nrow(productos)
## [1] 694

Serie temporal diaria.

productos_diaria_ts <- ts(data = productos$Totales,start = 2019, frequency = 365)
productos_diaria_xts <- xts(productos$Totales, 
                            order.by = productos$Fecha, frequency = 365)

Gráficas de la serie temporal.

Raíz unitaria

urca::ur.df(productos_diaria_ts)
## 
## ############################################################### 
## # Augmented Dickey-Fuller Test Unit Root / Cointegration Test # 
## ############################################################### 
## 
## The value of the test statistic is: -31.8151

El valor del estadístico de Dickey-Fuller es -31.8151 Este resultado, significativamente menor que el valor crítico, nos permite rechazar la hipótesis nula de que la serie tiene una raíz unitaria a un nivel de significancia del 5%. En consecuencia, concluimos que la serie de tiempo es estacionaria.

kpss.test(productos_diaria_ts)
## Warning in kpss.test(productos_diaria_ts): p-value greater than printed p-value
## 
##  KPSS Test for Level Stationarity
## 
## data:  productos_diaria_ts
## KPSS Level = 0.0071219, Truncation lag parameter = 6, p-value = 0.1

KPSS Level = 0.0071219, Truncation lag parameter = 6, p-value = 0.1 Ho:La serie de tiempo es estacionaria. Ha:La serie de tiempo no es estacionaria. Dado que el valor p es 0.1, mayor al nivel de significancia convencional de 0.05, no se rechaza la hipótesis nula. plot(decompose(productos_diaria_ts))

ACF Y PACF

ggAcf(productos_diaria_ts, col = "red", lag.max = 20)

ggPacf(productos_diaria_ts, col = "blue", lag.max = 10)

División de la serie temporal en el conjunto de entrenamiento y de prueba.

dividida_diaria_ts <- ts_split(productos_diaria_ts, 
                               sample.out = round(length(productos_diaria_ts)*0.2))

entrena_productos_diaria_ts <- dividida_diaria_ts$train

prueba_productos_diaria_ts <- dividida_diaria_ts$test

Modelo

modelo_prod_dia <- auto.arima(entrena_productos_diaria_ts, 
                                       seasonal = F,
                                       stepwise = F)


summary(modelo_prod_dia )
## Series: entrena_productos_diaria_ts 
## ARIMA(1,0,2) with zero mean 
## 
## Coefficients:
##          ar1      ma1     ma2
##       0.6993  -1.7055  0.7170
## s.e.  0.2279   0.2235  0.2197
## 
## sigma^2 = 3.002:  log likelihood = -1092.41
## AIC=2192.82   AICc=2192.89   BIC=2210.1
## 
## Training set error measures:
##                        ME     RMSE      MAE  MPE MAPE      MASE        ACF1
## Training set -0.005123487 1.727887 1.386558 -Inf  Inf 0.5031373 0.008331805
# AIC=2192.82   AICc=2192.89   BIC=2210.1
# ARIMA(1,0,2) with zero mean

Residuales

checkresiduals(modelo_prod_dia, col = "red") # p-value = 0.9631

## 
##  Ljung-Box test
## 
## data:  Residuals from ARIMA(1,0,2) with zero mean
## Q* = 83.235, df = 108, p-value = 0.9631
## 
## Model df: 3.   Total lags used: 111

Pronósticos

pronostico_diaria_prod <- forecast(modelo_prod_dia , 
                                   h = length(prueba_productos_diaria_ts), 
                                   level = 0.95)

Gráfica de pronósticos

plot(prueba_productos_diaria_ts[1:50],type = "l", col = "green", ylab = "Valores", 
     lwd = 2)
lines(pronostico_diaria_prod$fitted[1:50], type = "l", col = "darkorange")
lines(pronostico_diaria_prod$mean[1:50], type = "l", col = "darkred", lwd = 2, lty = 2)
legend("bottomleft", legend = c("prueba", "ajustado", "pronostico"),
       fill = c("green", "darkorange", "darkred"), cex = 0.6, lty = c(1,1,2))

Exactitud del modelo

accuracy(prueba_productos_diaria_ts, pronostico_diaria_prod$mean)
##                   ME    RMSE      MAE          MPE         MAPE       ACF1
## Test set 0.004529374 2.21399 1.660474 5.432005e+22 1.820467e+23 -0.3524233
##             Theil's U
## Test set 2.125549e+22
#                   ME    RMSE      MAE          MPE         MAPE       ACF1
#Test set 0.004529374 2.21399 1.660474 5.432005e+22 1.820467e+23 -0.3524233

Exactitud a 50 dias

accuracy(prueba_productos_diaria_ts[1:50], pronostico_diaria_prod$mean[1:50])
##                     ME     RMSE      MAE       MPE       MAPE
## Test set -0.0003449083 2.051954 1.682708 187142070 9726194525
#                     ME     RMSE      MAE       MPE       MAPE
# Test set -0.0003449083 2.051954 1.682708 187142070 9726194525

Conclusiones

El pronóstico determinado por el modelo esuna linea media de los valores, en este caso con valor nulo. Este modelo esta muy por debajo del mejor modelo que es el RML.